home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / dmpmat.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-22  |  14.0 KB  |  381 lines
  1. /* dmpmat.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     doublereal atime, aprog[3], adate, atitle[10], defl, defw, defad, defas, 
  26.         rstats[50];
  27.     integer iwidth, lwidth, nopage;
  28. } miscel_;
  29.  
  30. #define miscel_1 miscel_
  31.  
  32. struct {
  33.     doublereal achar, afield[15], oldlin[15];
  34.     integer kntrc, kntlim;
  35. } line_;
  36.  
  37. #define line_1 line_
  38.  
  39. struct {
  40.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  41.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  42. } cirdat_;
  43.  
  44. #define cirdat_1 cirdat_
  45.  
  46. struct {
  47.     doublereal vto, beta, gamma, phi, phib, cox, xnsub, xnfs, xd, xj, xld, 
  48.         xlamda, uo, uexp, vbp, utra, vmax, xneff, xl, xw, vbi, von, vdsat,
  49.          qspof, beta0, beta1, cdrain, xqco, xqc, fnarrw, fshort;
  50.     integer lev;
  51. } mosarg_;
  52.  
  53. #define mosarg_1 mosarg_
  54.  
  55. struct {
  56.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  57.         sfactr;
  58.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  59.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  60. } status_;
  61.  
  62. #define status_1 status_
  63.  
  64. struct {
  65.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  66.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  67. } flags_;
  68.  
  69. #define flags_1 flags_
  70.  
  71. struct {
  72.     doublereal twopi, xlog2, xlog10, root2, rad, boltz, charge, ctok, gmin, 
  73.         reltol, abstol, vntol, trtol, chgtol, eps0, epssil, epsox, pivtol,
  74.          pivrel;
  75. } knstnt_;
  76.  
  77. #define knstnt_1 knstnt_
  78.  
  79. struct {
  80.     doublereal cpyknt;
  81.     integer istack[1], lorg, icore, maxcor, maxuse, memavl, ldval, numblk, 
  82.         loctab, ltab, ifwa, nwoff, ntab, maxmem, memerr, nwd4, nwd8, 
  83.         nwd16;
  84. } memmgr_;
  85.  
  86. #define memmgr_1 memmgr_
  87.  
  88. struct {
  89.     doublereal tcstar[2], tcstop[2], tcincr[2];
  90.     integer icvflg, itcelm[2], kssop, kinel, kidin, kovar, kidout;
  91. } dc_;
  92.  
  93. #define dc_1 dc_
  94.  
  95. struct {
  96.     doublereal fstart, fstop, fincr, skw2, refprl, spw2;
  97.     integer jacflg, idfreq, inoise, nosprt, nosout, nosin, idist, idprt;
  98. } ac_;
  99.  
  100. #define ac_1 ac_
  101.  
  102. struct {
  103.     doublereal tstep, tstop, tstart, delmax, tdmax, forfre;
  104.     integer jtrflg;
  105. } tran_;
  106.  
  107. #define tran_1 tran_
  108.  
  109. struct {
  110.     doublereal xincr, string[15], xstart, yvar[8];
  111.     integer itab[8], itype[8], ilogy[8], npoint, numout, kntr, numdgt;
  112. } outinf_;
  113.  
  114. #define outinf_1 outinf_
  115.  
  116. struct {
  117.     integer maxtim, itime, icost;
  118. } cje_;
  119.  
  120. #define cje_1 cje_
  121.  
  122. struct {
  123.     integer idebug[20];
  124. } debug_;
  125.  
  126. #define debug_1 debug_
  127.  
  128. struct {
  129.     doublereal value[200000];
  130. } blank_;
  131.  
  132. #define blank_1 blank_
  133.  
  134. /* Table of constant values */
  135.  
  136. static integer c__1 = 1;
  137.  
  138. /*<       subroutine dmpmat(anam) >*/
  139. /* Subroutine */ int dmpmat_(anam)
  140. doublereal *anam;
  141. {
  142.     /* Format strings */
  143.     static char fmt_10[] = "(\0020*debug*:  dmpmt called by \002,a8,/,\002 *\
  144. debug*:  mode, mdc, time, delta, icalc, itr#, initf,\002,\002 piv, ord, ncon\
  145. , igoof, nogo =\002,/,\002 *debug*:  \002,2i5,1p2d10.2,8i5)";
  146.     static char fmt_16[] = "(\002 *debug*:  nstop, nttbr, size(irpt) = \002,\
  147. 3i6,/,\002 *debug*:   index  irpt  irow  jcol  jcpt       value\002,10x,\002\
  148.  index  irpt  irow  jcol  jcpt       value\002)";
  149.     static char fmt_26[] = 
  150.         "(\002 *debug*:  \002,5i6,1pd12.4,10x,5i6,1pd12.4)";
  151.     static char fmt_71[] = "(\002 *debug*:  irswpf = \002,18i6)";
  152.     static char fmt_76[] = "(\002 *debug*:  irswpr = \002,18i6)";
  153.     static char fmt_81[] = "(\002 *debug*:  icswpf = \002,18i6)";
  154.     static char fmt_86[] = "(\002 *debug*:  icswpr = \002,18i6)";
  155.  
  156.     /* System generated locals */
  157.     integer i_1;
  158.  
  159.     /* Builtin functions */
  160.     integer s_wsfe(), do_fio(), e_wsfe();
  161.  
  162.     /* Local variables */
  163.     static integer i, j, irpts, istop;
  164. #define nodplc ((integer *)&blank_1)
  165. #define cvalue ((complex *)&blank_1)
  166.     extern /* Subroutine */ int dmpmem_(), sizmem_();
  167.  
  168.     /* Fortran I/O blocks */
  169.     static cilist io__3 = { 0, 0, 0, fmt_10, 0 };
  170.     static cilist io__5 = { 0, 0, 0, fmt_16, 0 };
  171.     static cilist io__9 = { 0, 0, 0, fmt_26, 0 };
  172.     static cilist io__10 = { 0, 0, 0, fmt_71, 0 };
  173.     static cilist io__11 = { 0, 0, 0, fmt_76, 0 };
  174.     static cilist io__12 = { 0, 0, 0, fmt_81, 0 };
  175.     static cilist io__13 = { 0, 0, 0, fmt_86, 0 };
  176.  
  177.  
  178. /*<       implicit double precision (a-h,o-z) >*/
  179.  
  180. /*      this routine dumps out the matrix and associated pointers. */
  181.  
  182. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  183. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  184. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  185. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  186. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  187. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  188. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  189. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  190. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  191. /* spice version 2g.6  sccsid=miscel 3/15/83 */
  192. /*<       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, >*/
  193. /*<      1  defas,rstats(50),iwidth,lwidth,nopage >*/
  194. /* spice version 2g.6  sccsid=line 3/15/83 */
  195. /*<       common /line/ achar,afield(15),oldlin(15),kntrc,kntlim >*/
  196. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  197. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  198. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  199. /* spice version 2g.6  sccsid=mosarg 3/15/83 */
  200. /*<       common /mosarg/ vto,beta,gamma,phi,phib,cox,xnsub,xnfs,xd,xj,xld, >*/
  201. /*<      1   xlamda,uo,uexp,vbp,utra,vmax,xneff,xl,xw,vbi,von,vdsat,qspof, >*/
  202. /*<      2   beta0,beta1,cdrain,xqco,xqc,fnarrw,fshort,lev >*/
  203. /* spice version 2g.6  sccsid=status 3/15/83 */
  204. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  205. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  206. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  207. /* spice version 2g.6  sccsid=flags 3/15/83 */
  208. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  209. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  210. /* spice version 2g.6  sccsid=knstnt 3/15/83 */
  211. /*<       common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok, >*/
  212. /*<      1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox, >*/
  213. /*<      2   pivtol,pivrel >*/
  214. /* spice version 2g.6  sccsid=memmgr 3/15/83 */
  215. /*<       common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl, >*/
  216. /*<      1   ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4, >*/
  217. /*<      2   nwd8,nwd16 >*/
  218. /* spice version 2g.6  sccsid=dc 3/15/83 */
  219. /*<       common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop, >*/
  220. /*<      1   kinel,kidin,kovar,kidout >*/
  221. /* spice version 2g.6  sccsid=ac 3/15/83 */
  222. /*<       common /ac/ fstart,fstop,fincr,skw2,refprl,spw2,jacflg,idfreq, >*/
  223. /*<      1   inoise,nosprt,nosout,nosin,idist,idprt >*/
  224. /* spice version 2g.6  sccsid=tran 3/15/83 */
  225. /*<       common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg >*/
  226. /* spice version 2g.6  sccsid=outinf 3/15/83 */
  227. /*<       common /outinf/ xincr,string(15),xstart,yvar(8),itab(8),itype(8), >*/
  228. /*<      1   ilogy(8),npoint,numout,kntr,numdgt >*/
  229. /* spice version 2g.6  sccsid=cje 3/15/83 */
  230. /*<       common /cje/ maxtim,itime,icost >*/
  231. /* spice version 2g.6  sccsid=debug 3/15/83 */
  232. /*<       common/debug/ idebug(20) >*/
  233. /* spice version 2g.6  sccsid=blank 3/15/83 */
  234. /*<       common /blank/ value(200000) >*/
  235. /*<       integer nodplc(64) >*/
  236. /*<       complex cvalue(32) >*/
  237. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  238.  
  239.  
  240. /*<       write (iofile,10) anam,mode,modedc, >*/
  241. /*<      1 time,delta,icalc,iterno,initf,ipiv,iord,noncon,igoof,nogo >*/
  242.     io__3.ciunit = status_1.iofile;
  243.     s_wsfe(&io__3);
  244.     do_fio(&c__1, (char *)&(*anam), (ftnlen)sizeof(doublereal));
  245.     do_fio(&c__1, (char *)&status_1.mode, (ftnlen)sizeof(integer));
  246.     do_fio(&c__1, (char *)&status_1.modedc, (ftnlen)sizeof(integer));
  247.     do_fio(&c__1, (char *)&status_1.time, (ftnlen)sizeof(doublereal));
  248.     do_fio(&c__1, (char *)&status_1.delta, (ftnlen)sizeof(doublereal));
  249.     do_fio(&c__1, (char *)&status_1.icalc, (ftnlen)sizeof(integer));
  250.     do_fio(&c__1, (char *)&status_1.iterno, (ftnlen)sizeof(integer));
  251.     do_fio(&c__1, (char *)&status_1.initf, (ftnlen)sizeof(integer));
  252.     do_fio(&c__1, (char *)&status_1.ipiv, (ftnlen)sizeof(integer));
  253.     do_fio(&c__1, (char *)&status_1.iord, (ftnlen)sizeof(integer));
  254.     do_fio(&c__1, (char *)&status_1.noncon, (ftnlen)sizeof(integer));
  255.     do_fio(&c__1, (char *)&flags_1.igoof, (ftnlen)sizeof(integer));
  256.     do_fio(&c__1, (char *)&flags_1.nogo, (ftnlen)sizeof(integer));
  257.     e_wsfe();
  258. /*<    10 format('0*debug*:  dmpmt called by ',a8,/, >*/
  259. /*<      1   ' *debug*:  mode, mdc, time, delta, icalc, itr#, initf,', >*/
  260. /*<      2             ' piv, ord, ncon, igoof, nogo =',/, >*/
  261. /*<      3   ' *debug*:  ',2i5,1p2d10.2,8i5) >*/
  262. /*<       call dmpmem(5hdmpmt) >*/
  263.     dmpmem_("dmpmt", 5L);
  264.  
  265. /*  dump out the *whole* thing */
  266.  
  267. /*<       call sizmem(irpt,irpts) >*/
  268.     sizmem_(&tabinf_1.irpt, &irpts);
  269. /*<       write (iofile,16) nstop,nttbr,irpts >*/
  270.     io__5.ciunit = status_1.iofile;
  271.     s_wsfe(&io__5);
  272.     do_fio(&c__1, (char *)&cirdat_1.nstop, (ftnlen)sizeof(integer));
  273.     do_fio(&c__1, (char *)&tabinf_1.nttbr, (ftnlen)sizeof(integer));
  274.     do_fio(&c__1, (char *)&irpts, (ftnlen)sizeof(integer));
  275.     e_wsfe();
  276. /*<    16 format(' *debug*:  nstop, nttbr, size(irpt) = ',3i6,/, >*/
  277. /*<      1   ' *debug*:   index  irpt  irow  jcol  jcpt       value', >*/
  278. /*<      2          10x,' index  irpt  irow  jcol  jcpt       value') >*/
  279. /*<       j=(irpts+1)/2 >*/
  280.     j = (irpts + 1) / 2;
  281. /*<       istop=j >*/
  282.     istop = j;
  283. /*<       do 30 i=1,istop >*/
  284.     i_1 = istop;
  285.     for (i = 1; i <= i_1; ++i) {
  286. /*<       j=j+1 >*/
  287.     ++j;
  288. /*<       write (iofile,26) >*/
  289. /*<      1   i,nodplc(irpt+i),nodplc(irowno+i),nodplc(jcolno+i), >*/
  290. /*<      2   nodplc(jcpt+i),value(lvn+i), >*/
  291. /*<      3   j,nodplc(irpt+j),nodplc(irowno+j),nodplc(jcolno+j), >*/
  292. /*<      4   nodplc(jcpt+j),value(lvn+j) >*/
  293.     io__9.ciunit = status_1.iofile;
  294.     s_wsfe(&io__9);
  295.     do_fio(&c__1, (char *)&i, (ftnlen)sizeof(integer));
  296.     do_fio(&c__1, (char *)&nodplc[tabinf_1.irpt + i - 1], (ftnlen)sizeof(
  297.         integer));
  298.     do_fio(&c__1, (char *)&nodplc[tabinf_1.irowno + i - 1], (ftnlen)
  299.         sizeof(integer));
  300.     do_fio(&c__1, (char *)&nodplc[tabinf_1.jcolno + i - 1], (ftnlen)
  301.         sizeof(integer));
  302.     do_fio(&c__1, (char *)&nodplc[tabinf_1.jcpt + i - 1], (ftnlen)sizeof(
  303.         integer));
  304.     do_fio(&c__1, (char *)&blank_1.value[tabinf_1.lvn + i - 1], (ftnlen)
  305.         sizeof(doublereal));
  306.     do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer));
  307.     do_fio(&c__1, (char *)&nodplc[tabinf_1.irpt + j - 1], (ftnlen)sizeof(
  308.         integer));
  309.     do_fio(&c__1, (char *)&nodplc[tabinf_1.irowno + j - 1], (ftnlen)
  310.         sizeof(integer));
  311.     do_fio(&c__1, (char *)&nodplc[tabinf_1.jcolno + j - 1], (ftnlen)
  312.         sizeof(integer));
  313.     do_fio(&c__1, (char *)&nodplc[tabinf_1.jcpt + j - 1], (ftnlen)sizeof(
  314.         integer));
  315.     do_fio(&c__1, (char *)&blank_1.value[tabinf_1.lvn + j - 1], (ftnlen)
  316.         sizeof(doublereal));
  317.     e_wsfe();
  318. /*<    26 format(' *debug*:  ',5i6,1pd12.4,10x,5i6,1pd12.4) >*/
  319. /*<    30 continue >*/
  320. /* L30: */
  321.     }
  322. /* c 51 format(" *debug*:  irpt   = ",18i6) */
  323. /* c    write (iofile,56) (nodplc(irowno+i),i=1,irpts) */
  324. /* c 56 format(" *debug*:  irowno = ",18i6) */
  325. /* c    write (iofile,61) (nodplc(jcolno+i),i=1,irpts) */
  326. /* c 61 format(" *debug*:  jcolno = ",18i6) */
  327. /* c    write (iofile,66) (nodplc(jcpt  +i),i=1,irpts) */
  328. /* c 66 format(" *debug*:  jcpt   = ",18i6) */
  329. /*<       write (iofile,71) (nodplc(irswpf+i),i=1,nstop) >*/
  330.     io__10.ciunit = status_1.iofile;
  331.     s_wsfe(&io__10);
  332.     i_1 = cirdat_1.nstop;
  333.     for (i = 1; i <= i_1; ++i) {
  334.     do_fio(&c__1, (char *)&nodplc[tabinf_1.irswpf + i - 1], (ftnlen)
  335.         sizeof(integer));
  336.     }
  337.     e_wsfe();
  338. /*<    71 format(' *debug*:  irswpf = ',18i6) >*/
  339. /*<       write (iofile,76) (nodplc(irswpr+i),i=1,nstop) >*/
  340.     io__11.ciunit = status_1.iofile;
  341.     s_wsfe(&io__11);
  342.     i_1 = cirdat_1.nstop;
  343.     for (i = 1; i <= i_1; ++i) {
  344.     do_fio(&c__1, (char *)&nodplc[tabinf_1.irswpr + i - 1], (ftnlen)
  345.         sizeof(integer));
  346.     }
  347.     e_wsfe();
  348. /*<    76 format(' *debug*:  irswpr = ',18i6) >*/
  349. /*<       write (iofile,81) (nodplc(icswpf+i),i=1,nstop) >*/
  350.     io__12.ciunit = status_1.iofile;
  351.     s_wsfe(&io__12);
  352.     i_1 = cirdat_1.nstop;
  353.     for (i = 1; i <= i_1; ++i) {
  354.     do_fio(&c__1, (char *)&nodplc[tabinf_1.icswpf + i - 1], (ftnlen)
  355.         sizeof(integer));
  356.     }
  357.     e_wsfe();
  358. /*<    81 format(' *debug*:  icswpf = ',18i6) >*/
  359. /*<       write (iofile,86) (nodplc(icswpr+i),i=1,nstop) >*/
  360.     io__13.ciunit = status_1.iofile;
  361.     s_wsfe(&io__13);
  362.     i_1 = cirdat_1.nstop;
  363.     for (i = 1; i <= i_1; ++i) {
  364.     do_fio(&c__1, (char *)&nodplc[tabinf_1.icswpr + i - 1], (ftnlen)
  365.         sizeof(integer));
  366.     }
  367.     e_wsfe();
  368. /*<    86 format(' *debug*:  icswpr = ',18i6) >*/
  369.  
  370.  
  371. /*<   500 return >*/
  372. /* L500: */
  373.     return 0;
  374. /*<       end >*/
  375. } /* dmpmat_ */
  376.  
  377. #undef cvalue
  378. #undef nodplc
  379.  
  380.  
  381.